Aminet 40/Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso/Aminet/misc/emu/ATUtilities.lha/ATUtilities/BASIC/GEMDOS.INC

Text File | 2000-09-26 | 18.8 KB | 946 lines

$INCLUDE "REGNAMES.INC"
$STACK 2000

%GADGHNONE=1
%GADGHCOMP=2
%TOGGLESELECT=3
%MENUGAD=4
%STRGAD=5
GemDOS$="GemDOS-V1.0"
GemDir$=curdir$

on error goto gemdos.fehler
goto gemdos.fertig

sub DrawPBorder(xo,yo,wo,ho,t$) static
 x=xo*8-2  : w=wo*8
 y=yo*16-4 : h=ho*16+4
 line (x,y+h)-(x,y),15
 line -(x+w,y),15
 line (x+w,y+1)-(x+w,y+h),7
 line -(x+1,y+h),7
 locate yo+1,xo+3
 if len(t$)<>1 then
  color 15
  print t$
 else
  reg %ax,&H09*256+asc(t$)
  reg %bx,15
  reg %cx,1
  call interrupt &H10
 end if
end sub

sub AsciiPrint(c,t$) static
 for i=1 to len(t$)
  reg %ax,&H09*256+asc(mid$(t$,i,1))
  reg %bx,c
  reg %cx,1
  call interrupt &H10
  locate ,pos+1
 next
end sub

sub DrawNBorder(xo,yo,wo,ho,t$) static
 x=xo*8-2  : w=wo*8
 y=yo*16-4 : h=ho*16+4
 line (x,y+h)-(x,y),7
 line -(x+w,y),7
 line (x+w,y+1)-(x+w,y+h),15
 line -(x+1,y+h),15
 locate yo+1,xo+3
 color 15
 print t$
end sub

sub MouseOn static
 reg %ax,&H0001
 call interrupt &H33
end sub

sub MouseOff static
 reg %ax,&H0002
 call interrupt &H33
end sub

sub MouseDown shared
 reg %ax,&H0005
 reg %bx,0
 call interrupt &H33
 mouse.x=reg(%cx)
 mouse.y=reg(%dx)
 mouse.button=reg(%bx)
 reg %ax,&H0006
 reg %bx,0
 call interrupt &H33
 mouse.upbutton=reg(%bx)
end sub

sub MouseUp shared
 reg %ax,&H0006
 reg %bx,0
 call interrupt &H33
 mouse.x=reg(%cx)
 mouse.y=reg(%dx)
 mouse.button=reg(%BX)
end sub

sub MouseXY shared
 reg %ax,&H0003
 reg %bx,0
 call interrupt &H33
 mouse.x=reg(%cx)
 mouse.y=reg(%dx)
end sub

sub InitScreen(anz,t$) shared
 reg %ax,&H1a00
 call interrupt &H10
 vga=reg(%ax)
 vga=int(vga mod 256)
 if vga<>&H1a then
  print "Dieses Programm ben”tigt eine VGA-Grafikkarte!"
  end
 end if

 call CheckMouse
 screen 12

 for i=0 to 15
  palette i,i
 next

 call LoadColors
 call LoadMousePrefs

 reg %ax,0
 call interrupt &H33

 call PrepareScreen(anz,t$)
 exit sub
end sub

sub LadeST static
8771 error 0
8772 open gemdir$+"signalton.dat" for input as #1
 if erl=8772 then
  signalton=0
 else
  signalton=asc(input$(1,1))
  close #1
 end if
end sub

sub LoadMousePrefs static
7771 error 0
7772 open gemdir$+"maus.dat" for input as #1
 if erl=7771 then
  a=cvi(input$(2,1))
  b=cvi(input$(2,1))
  c=cvi(input$(2,1))
  close #1
 else
  a=50
  b=50
  c=50
 end if

 reg %ax,&H1a
 reg %bx,a
 reg %cx,b
 reg %dx,c
 call interrupt &H33
end sub

sub LoadColors static
7777 error 0
7778 open gemdir$+"farben.dat" for input as #1
 if erl<>7777 then
  goto LoadColors.default
 end if

 for i=0 to 15
  r=asc(input$(1,1))
  g=asc(input$(1,1))
  b=asc(input$(1,1))
  reg %ax,&H10*256+&H10
  reg %bx,i
  reg %cx,g*256+b
  reg %dx,r*256
  call interrupt &H10
 next
 close #1
 exit sub

LoadColors.default:
 reg %ax,&H10*256+&H10
 reg %bx,0
 reg %cx,16*256+48
 reg %dx,16*256
 call interrupt &H10
 reg %ax,&H10*256+&H10
 reg %bx,7
 reg %cx,0
 reg %dx,0
 call interrupt &H10
 reg %ax,&H10*256+&H10
 reg %bx,15
 reg %cx,&HFFFF
 reg %dx,&HFF00
 call interrupt &H10
end sub

sub PrepareScreen(anz,t$) shared
 for i=0 to 15
  palette i,i
 next
 line (1,1)-(640,480),0,bf
 dim gad.x1(anz),b.x1(anz)
 dim gad.x2(anz),b.x2(anz)
 dim gad.y1(anz),b.y1(anz)
 dim gad.y2(anz),b.y2(anz)
 dim gad.x(anz),b.x(anz)
 dim gad.y(anz),b.y(anz)
 dim gad.w(anz),b.w(anz)
 dim gad.h(anz),b.h(anz)
 dim gad.text$(anz),b.text$(anz)
 dim gad.flags(anz),b.flags(anz)
 dim gad.selected(anz),b.selected(anz)
 dim gad.number(anz),b.number(anz)
 dim gad.strmax(anz),b.strmax(anz)
 gad.count=0
 gad.max=anz
 gad.id=-1
 gad.num=-1
 menu.num=-1
 screen.title$=t$
 call DrawPBorder(5,1,74,1,"")
 call BoolGadget(1,1,3,1,"",33333)
 call DrawPBorder(1,3,78,26,"")
 call Center(5,screen.title$)
 call LadeST
end sub

sub MouseHandler shared
 gad.id=-1
 gad.num=-1
 if gad.count>0 then
  for i=0 to gad.count-1
   if mouse.x>=gad.x1(i) and mouse.x<=gad.x2(i) then
    if mouse.y>=gad.y1(i) and mouse.y<=gad.y2(i) then
     gad.id=i
     call GadgetHandler
     exit sub
    end if
   end if
  next
 end if
end sub

sub GadgetHandler shared
 if gad.id=-1 then exit sub
 if gad.flags(gad.id)=%GADGHCOMP then
  call MouseOff
  call DrawNBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(id),"")
  call MouseOn
  mouse.button=mouse.upbutton
  while mouse.button=0
   call MouseUp
  wend
  call MouseOff
  call DrawPBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(id),"")
  call MouseOn
  i=gad.id
  gad.id=-1
  if mouse.x>=gad.x1(i) and mouse.x<=gad.x2(i) then
    if mouse.y>=gad.y1(i) and mouse.y<=gad.y2(i) then
     gad.id=i
    end if
  end if
 elseif gad.flags(gad.id)=%MENUGAD or gad.flags(gad.id)=%GADGHNONE then
  call MouseUp
 elseif gad.flags(gad.id)=%TOGGLESELECT then
  call MouseUp
  call MouseOff
  if gad.selected(gad.id)=0 then
   call DrawPBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(gad.id),"")
   gad.selected(gad.id)=1
  else
   call DrawNBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(gad.id),"")
   gad.selected(gad.id)=0
  end if
  call MouseOn
 end if
 if gad.flags(gad.id)=%STRGAD then
  key 25,chr$(0,&H53)
  on key(12) gosub links
  on key(13) gosub rechts
  on key(25) gosub del.taste
  key(12) on
  key(13) on
  key(25) on
  sp=len(gad.text$(gad.id))
  mx=gad.strmax(gad.id)
  zz=mouse.x-gad.x1(gad.id)-8
  if zz<0 then zz=0
  zz=zz/8
  if zz>sp then
   cursor=sp
  else
   cursor=zz
  end if
  undo$=gad.text$(gad.id)
  call Neu
  i$=inkey$
  call MouseDown
  while i$<>chr$(13) and mouse.button=0
   if i$<>"" then
    select case i$
     case chr$(8)
      if sp>0 and cursor>0 then
       q$=gad.text$(gad.id)
       gad.text$(gad.id)=left$(q$,cursor-1)+mid$(q$,cursor+1,sp-cursor)
       cursor=cursor-1
       sp=sp-1
       call Neu
      else
       call Audio(2000,1)
      end if
     case chr$(27)
      gad.text$(gad.id)=undo$
      sp=len(undo$)
      call Neu
     case else
      if asc(i$)>30 then
       if sp<mx then
        q$=gad.text$(gad.id)
        gad.text$(gad.id)=left$(q$,cursor)+i$+mid$(q$,cursor+1,sp-cursor)
        sp=sp+1 : cursor=cursor+1
        call Neu
       else
        call Audio(2000,1)
       end if
      else
       call Audio(2000,1)
      end if
    end select
   end if
   i$=inkey$
   call MouseDown
  wend
  cursor=33333
  call Neu
  key(12) off
  key(13) off
  key(25) off
  gad.num=gad.id
 end if
 if gad.id<>-1 then
  gad.num=gad.number(gad.id)
 end if
end sub

links:
 if cursor>0 then
  cursor=cursor-1
  call Neu
 end if
return

rechts:
 if cursor<sp then
  cursor=cursor+1
  call Neu
 end if
return

del.taste:
 if cursor<sp and sp>0 then
  q$=gad.text$(gad.id)
  gad.text$(gad.id)=left$(q$,cursor)+mid$(q$,cursor+2,sp-cursor)
  sp=sp-1
  if cursor>sp then cursor=cursor-1
  call Neu
 end if
return

sub Neu shared
 call MouseOff
 locate gad.y(gad.id)+1,gad.x(gad.id)+2
 color 15
 z$=gad.text$(gad.id)+string$(1+gad.strmax(gad.id)-len(gad.text$(gad.id))," ")
 print z$;
 if cursor<33333 then
  color 14
  locate gad.y(gad.id)+1,gad.x(gad.id)+2+cursor
  z$=mid$(z$,cursor+1,1)
  if z$=" " then z$="_"
  print z$;
 end if
 call MouseOn
end sub

sub BoolGadget(x,y,w,h,text$,id) shared
 if gad.count>=gad.max then exit sub
 gad.x(gad.count)=x
 gad.y(gad.count)=y
 gad.w(gad.count)=w
 gad.h(gad.count)=h
 gad.x1(gad.count)=x*8-2
 gad.y1(gad.count)=y*16-6
 gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
 gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
 gad.text$(gad.count)=text$
 gad.flags(gad.count)=%GADGHCOMP
 gad.selected(gad.count)=0
 gad.number(gad.count)=id
 gad.count=gad.count+1
 call DrawPBorder(x,y,w,h,text$)
end sub

sub StrGadget(x,y,w,h,text$,mx,id) shared
 if gad.count>=gad.max then exit sub
 gad.x(gad.count)=x
 gad.y(gad.count)=y
 gad.w(gad.count)=w
 gad.h(gad.count)=h
 gad.x1(gad.count)=x*8-2
 gad.y1(gad.count)=y*16-6
 gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
 gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
 gad.text$(gad.count)=text$
 gad.flags(gad.count)=%STRGAD
 gad.selected(gad.count)=0
 gad.number(gad.count)=id
 gad.strmax(gad.count)=mx
 gad.count=gad.count+1
 call DrawNBorder(x,y,w,h,"")
 color 15
 locate y+1,x+2
 print text$
end sub

sub MinGadget(x,y,w,h,id) shared
 if gad.count>=gad.max then exit sub
 gad.x(gad.count)=x
 gad.y(gad.count)=y
 gad.w(gad.count)=w
 gad.h(gad.count)=h
 gad.x1(gad.count)=x*8-2
 gad.y1(gad.count)=y*16-6
 gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
 gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
 gad.text$(gad.count)=text$
 gad.flags(gad.count)=%GADGHNONE
 gad.selected(gad.count)=0
 gad.number(gad.count)=id
 gad.count=gad.count+1
end sub

sub ToggleGadget(x,y,w,h,text$,selected,id) shared
 if gad.count>=gad.max then exit sub
 gad.x(gad.count)=x
 gad.y(gad.count)=y
 gad.w(gad.count)=w
 gad.h(gad.count)=h
 gad.x1(gad.count)=x*8-2
 gad.y1(gad.count)=y*16-6
 gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
 gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
 gad.text$(gad.count)=text$
 gad.flags(gad.count)=%TOGGLESELECT
 gad.selected(gad.count)=selected
 gad.number(gad.count)=id
 gad.count=gad.count+1
 if selected=0 then
  call DrawNBorder(x,y,w,h,text$)
 else
  call DrawPBorder(x,y,w,h,text$)
 end if
end sub

function GetGadgetID(number) shared
 for i=0 to gad.count-1
  if gad.number(i)=number then
   GetGadgetID=i
   exit function
  end if
 next
end function

sub RemoveGadget(number) shared
 call MouseOff
 num=GetGadgetID(number)
 if num=-1 then exit sub
 if gad.flags(num)<>%MENUGAD then
  line (gad.x1(num),gad.y1(num))-(gad.x2(num)+1,gad.y2(num)+2),0,bf
 else
  locate gad.y(num)+1,gad.x(num)+1
  color 0
  print gad.text$(num)
 end if
 call MouseOn
 if gad.count<gad.max then
  for i=num to gad.max-1
   gad.x1(i)=gad.x1(i+1)
   gad.x2(i)=gad.x2(i+1)
   gad.y1(i)=gad.y1(i+1)
   gad.y2(i)=gad.y2(i+1)
   gad.x(i)=gad.x(i+1)
   gad.y(i)=gad.y(i+1)
   gad.w(i)=gad.w(i+1)
   gad.h(i)=gad.h(i+1)
   gad.text$(i)=gad.text$(i+1)
   gad.flags(i)=gad.flags(i+1)
   gad.selected(i)=gad.selected(i+1)
   gad.number(i)=gad.number(i+1)
   gad.strmax(i)=gad.strmax(i+1)
  next
 end if
 gad.count=gad.count-1
end sub

function GetGadgetText$(number) shared
 num=GetGadgetID(number)
 if num=-1 then
  GetGadgetText$=""
 else
  GetGadgetText$=gad.text$(num)
 end if
end function

sub MenuGadget(x,text$,id) shared
 if gad.count>=gad.max then exit sub
 y=1
 h=1
 w=len(text$)
 gad.x(gad.count)=x
 gad.y(gad.count)=y
 gad.w(gad.count)=w
 gad.h(gad.count)=h
 gad.x1(gad.count)=x*8-2
 gad.y1(gad.count)=y*16-6
 gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
 gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
 gad.text$(gad.count)=text$
 gad.flags(gad.count)=%MENUGAD
 gad.selected(gad.count)=0
 gad.number(gad.count)=id
 gad.count=gad.count+1
 locate y+1,x+1
 print text$
end sub

sub MenuHandler(x,w,feld$(),anz) shared
 ax1=x*8
 ay1=30
 ax2=ax1+w
 ay2=ay1+(anz*16)+8
 size=6+(ay2-ay1+1)*2*int((ax2-ax1+16)/16)*4
 dos.fehler=0
 free=fre(-1)
 dim backup%(size)
 if dos.fehler<>0 then call Crash(free,size*2)
 call MouseOff
 get (ax1,ay1)-(ax2,ay2),backup%
 line (ax1,ay1)-(ax2,ay2),0,bf
 line (ax1,ay2)-(ax1,ay1),15
 line -(ax2,ay1),15
 line (ax1+1,ay2)-(ax2,ay2),7
 line -(ax2,ay1+1),7
 color 15
 for i=0 to anz-1
  if feld$(i)="-" then
   ty=(3+i)*16-8
   line (ax1+1,ty)-(ax2-1,ty),15
  elseif right$(feld$(i),1)=chr$(0) then
   color 3
   locate 3+i,x+3
   print feld$(i)
  else
   color 15
   locate 3+i,x+3
   print feld$(i)
  end if
 next
 call MouseOn

 of=-1
 call MouseDown
 while mouse.button=0
  call MouseXY
  if mouse.x>ax1 and mouse.x<ax2 then
   y=int(mouse.y/16)+1
   if y>=3 and y<3+anz then
    if of<>y-3 then
     if of<>-1 then
      call MouseOff
      color 15
      locate oy,ox
      print feld$(of)
      call MouseOn
     end if
     if feld$(y-3)<>"-" and right$(feld$(y-3),1)<>chr$(0) then
      oy=y
      ox=x+3
      of=y-3
      call MouseOff
      color 14
      locate oy,ox
      print feld$(of)
      call MouseOn
     else
      of=-1
     end if
     call MouseOn
    end if
   else
    if of<>-1 then
     call MouseOff
     color 15
     locate oy,ox
     print feld$(of)
     call MouseOn
     of=-1
    end if
   end if
  end if
  call MouseDown
 wend
 y=int(mouse.y/16)+1
 menu.num=-1
 if y>=3 and y<3+anz and mouse.x>ax1 and mouse.x<ax2 then
  if feld$(y-3)<>"-" and right$(feld$(y-3),1)<>chr$(0) then
   menu.num=y-3
   if mid$(feld$(menu.num),1,1)=" " then
    mid$(feld$(menu.num),1,1)=chr$(251)
   elseif mid$(feld$(menu.num),1,1)=chr$(251) then
    mid$(feld$(menu.num),1,1)=" "
   end if
  end if
 end if

 call MouseOff
 put (ax1,ay1),backup%,pset
 erase backup%
 color 15
 call MouseOn
end sub

function ToggleMenuStatus(titel$) static
 if mid$(titel$,1,1)=" " then
  ToggleMenuStatus=0
 elseif mid$(titel$,1,1)=chr$(251) then
  ToggleMenuStatus=1
 else
  ToggleMenuStatus=-1
 end if
end function

sub SetToggleMenu(titel$,onoff) static
 if onoff=1 then c$=chr$(251) else c$=" "
 mid$(titel$,1,1)=c$
end sub

sub ItemOn(titel$) static
 if right$(titel$,1)=chr$(0) then
  mid$(titel$,len(titel$),1)=" "
 end if
end sub

sub ItemOff(titel$) static
 if right$(titel$,1)<>chr$(0) then
  titel$=titel$+chr$(0)
 elseif right$(titel$,1)=" " then
  mid$(titel$,len(titel$),1)=chr$(0)
 end if
end sub

sub BackupMenu shared
 dim title%(639*34/2)
 call MouseOff
 get (1,1)-(639,34),title%
 call MouseOn
end sub

sub RestoreMenu shared
 put (1,1),title%,pset
 erase title%
 call Center(5,screen.title$)
end sub

sub RefreshGadgets shared
 call MouseOff
 line (0,35)-(640,480),0,bf
 call DrawPBorder(1,3,78,26,"")
 for i=0 to gad.count-1
  if gad.flags(i)=%GADGHCOMP then
   call DrawPBorder(gad.x(i),gad.y(i),gad.w(i),gad.h(i),gad.text$(i))
  elseif gad.flags(i)=%TOGGLESELECT then
   if gad.selected(i)=1 then
    call DrawPBorder(gad.x(i),gad.y(i),gad.w(i),gad.h(i),gad.text$(i))
   else
    call DrawNBorder(gad.x(i),gad.y(i),gad.w(i),gad.h(i),gad.text$(i))
   end if
  end if
 next
 call MouseOn
end sub

sub CheckMouse static
 test=xMouseExist
 if test=0 then
  call Bell
  print "Fehler: Maustreiber ist nicht vorhanden!"
  print ""
  end
 end if
end sub

function xMouseExist public
 def seg = 0
 mouseseg& = peek(206)+256*peek(207)
 mouseofs& = peek(204)+256*peek(205)
 def seg = mouseseg&

 if (mouseseg& = 0 and mouseofs& = 0) or peek(mouseofs&) = 207 then
  xMouseExist=0
 else
  xMouseExist=1
 end if
 def seg
end function

sub Center(y,t$) static
 locate y,(80-len(t$))/2
 print t$
end sub

sub CleanUp shared
 call MouseOff
 reg %ax,0
 call interrupt &H33
 screen 0
 cls
end sub

sub LoadApp(appName$) static
 shared GemDOS$

 call MouseOff
 call BackupMenu

 x$=appName$+" "+GemDOS$
 locate 4,5
 shell x$
 for i=0 to 15
  palette i,i
 next

 call RefreshGadgets
 call RestoreMenu
 call MouseUp
 call MouseDown
 call MouseOn
end sub

sub LoadNonApp(prgName$,xwait) static
 call MouseOff
 call BackupMenu
 dim c(15)
 dim d(15)
 for i=0 to 15
  reg %ax,&H10*256+&H15
  reg %bx,i
  call interrupt &H10
  c(i)=reg(%cx)
  d(i)=reg(%dx)
 next

 screen 0
 cls
 shell prgName$
 if x=1 then
  color 15
  print ""
  print ""
  print ""
  print "Drcken Sie eine beliebige Taste, um zum Anwendungsprogramm zurckzukehren."
  while inkey$="":wend
 end if

 screen 12
 cls
 for i=0 to 15
  palette i,i
 next
 line (1,1)-(640,480),0,bf
 for i=0 to 15
  reg %ax,&H10*256+&H10
  reg %bx,i
  reg %cx,c(i)
  reg %dx,d(i)
  call interrupt &H10
 next
 call RefreshGadgets
 call RestoreMenu
 call MouseUp
 call MouseDown
 call MouseOn
 erase c,d
end sub

gemdos.fehler:
 dos.fehler=err
 dos.fzeile=erl
resume next

sub NewWindow(x1,y1,w1,h1,mousetrap) shared
 x=x1*8-4
 y=y1*16-8
 w=w1*8+8
 h=h1*16+16
 xx=x+w
 yy=y+h
 dos.fehler=0
 free=fre(-1)
 size=6+(yy-y+1)*2*int((xx-x+16)/16)*4
 dim dynamic win%(size)
 if dos.fehler<>0 then call Crash(free,size*2)
 call MouseOff
 get (x,y)-(xx,yy),win%
 win.x=x
 win.y=y
 win.w=w1
 win.l=x1
 line (x,y)-(x+w,y+h),0,bf
 line (x+1,y+h-2)-(x+1,y+1),15
 line -(x+w-2,y+1),15
 line (x+2,y+h-2)-(x+w-2,y+h-2),7
 line -(x+w-2,y+2),7
 if mousetrap=1 then
  reg %ax,&H7
  reg %cx,x+2
  reg %dx,x+w-14
  call interrupt &H33
  reg %ax,&H8
  reg %cx,y+2
  reg %dx,y+h-20
  call interrupt &H33
  reg %ax,&H4
  reg %cx,x+32
  reg %dx,y+16
  call interrupt &H33
  win.gads=gad.count
  for anz=0 to gad.count-1
   b.x1(anz)=gad.x1(anz)
   b.x2(anz)=gad.x2(anz)
   b.y1(anz)=gad.y1(anz)
   b.y2(anz)=gad.y2(anz)
   b.x(anz)=gad.x(anz)
   b.y(anz)=gad.y(anz)
   b.w(anz)=gad.w(anz)
   b.h(anz)=gad.h(anz)
   b.text$(anz)=gad.text$(anz)
   b.flags(anz)=gad.flags(anz)
   b.selected(anz)=gad.selected(anz)
   b.number(anz)=gad.number(anz)
   b.strmax(anz)=gad.strmax(anz)
  next
  gad.count=0
  win.mousetrap=1
 else
  win.mousetrap=0
 end if
 call MouseOn
end sub

sub CloseWindow shared
 call MouseOff
 put (win.x,win.y),win%,pset
 erase win%
 if win.mousetrap=1 then
  reg %ax,&H7
  reg %cx,0
  reg %dx,640
  call interrupt &H33
  reg %ax,&H8
  reg %cx,0
  reg %dx,480
  call interrupt &H33
  gad.count=win.gads
  for anz=0 to win.gads-1
   gad.x1(anz)=b.x1(anz)
   gad.x2(anz)=b.x2(anz)
   gad.y1(anz)=b.y1(anz)
   gad.y2(anz)=b.y2(anz)
   gad.x(anz)=b.x(anz)
   gad.y(anz)=b.y(anz)
   gad.w(anz)=b.w(anz)
   gad.h(anz)=b.h(anz)
   gad.text$(anz)=b.text$(anz)
   gad.flags(anz)=b.flags(anz)
   gad.selected(anz)=b.selected(anz)
   gad.number(anz)=b.number(anz)
   gad.strmax(anz)=b.strmax(anz)
  next
 end if
 call MouseOn
end sub

sub WaitForClick shared
 call MouseDown
 while mouse.button=0
  call MouseDown
 wend
 call MouseUp
 while mouse.button=0
  call MouseUp
 wend
end sub

sub CenterInWindow(y,t$) shared
 locate y,1+win.l+((win.w-len(t$))/2)
 print t$
end sub

sub InformationBox(t$,c1$,c2$,c3$) shared
 call NewWindow(15,12,50,7,0)
 call MouseOff
 color 15
 call CenterInWindow(13,t$)
 call CenterInWindow(15,c1$)
 call CenterInWindow(16,c2$)
 call CenterInWindow(17,c3$)
 call CenterInWindow(19,"Freier Speicher:"+str$(int(fre(-1)/1024))+" KBytes")
 call MouseOn
 call WaitForClick
 call CloseWindow
end sub

sub Bell static
 if signalton=0 then beep
end sub

sub Audio(freq,dauer) static
 if signalton=0 then sound freq,dauer
end sub

sub Crash(free,required) static
 screen 0
 color 14
 print "Vorhandener Speicher:";free;" Bytes"
 print "Ben”tigter Speicher: ";required;" Bytes"
 print ""
 print "Differenz:           ";required-free;" Bytes"
 print ""
 print "Die Ausfhrung des Anwendungsprogramms muáte abgebrochen werden, weil"
 print "nicht mehr genug freier Speicher verfgbar war!"
 call Bell
 end
end sub



gemdos.fertig: